C  THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C  AT STANFORD UNIVERSITY.  IT MAY NOT BE COPIED OR ALTERED IN ANY
C  WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.


C  1/79 **********  SCORE - PDP11 VERSION ********** 

C   THIS PROGRAM WRITES NOTE LISTS FOR THE PDP11 MUSIC V SOUND
C   GENERATION PROGRAM.
C   IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO'('HELP') FORMAT.
C   LOAD 'S1' WITH S2,SCANR

	COMMON /DEVS/ID1,ID21,JTYPE,ID23,ID20
	COMMON /Q/ BNW(200),NWZ /INS/RINST(27),BG(60) /TYP/JOUT,LN
	1 /ITYP/ITYP,JED 
C  SEE LABEL 1774 AND BELOW RE. BUFFER LIMIT.
	COMMON/VV/LIMIT,V(2000) /A/NP(27),XT(27), FRM(80),INVIS(27)
	DIMENSION LIST(1),JNP(80)
C   WITH VX,IOUT AT 70 AND FRM AT 80 OK FOR ONLY 
C   40 LIT CHARS + 30 PARAMS PER INST.
C   60 BG TIMES AVAILABLE. 

C 2ND NUM IN IPT=NUMP+2. (NUMPY) 
	COMMON /PCIP/ PCH(27,33) /ALPH/IALPH(14),ISCA(12),IDAT(11)
	1 /INP/INP(154) 
CC	/IPT/ IPT(27,32)
CC	COMMON/P/P(30) 
C NUMP=30 = TOTAL NUMBER OF PARAMETERS NOW AVAILABLE. RAN.DEV. IS NUMP+1
	COMMON J,L /DUR/DUR(27) /NUMP/NUMP
	1 /BLA/IBLA,KSLA,ISEMI,MINUS,ISTAR,ICOMM,ICOL,IQUES,ILESS,IQT
	1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG
	1 ,VX(70),IAMP,K,KN,M,ML,CODE
	COMMON/B/MOT,PR,T5,NINS,I,RA,KZY,NWX,INONLY,MX,
	1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,NL,RC,W,
	1 ZZ,CHN,YY 
	1 /D/TF,AMPFAC,OP1,DURX,IXIN,FLNM
	1  /C/LPAR,IPRN,QX,IRETRO,INVRT,ICON,LCNT,
	1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
	1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
C  /C/=26
	EQUIVALENCE (LIST,FRM(3)),(JN,JNP,INP),(IEE,ISCA(5)),(IDD,ISCA(3))
	1,(ITT,ISCA(11)),(III,IALPH(2)),(IYY,IALPH(14)),(JN2,JNP(2)),
	1(JN3,JNP(3)),(JN4,JNP(4)),(INN,IALPH(7)),(IOO,ISCA(4)),(IFF,
	1 ISCA(6)),(IHH,IALPH(1)),(ILL,IALPH(5)),(IPP,ISCA(2))
	DATA KZY/27/,ISEMI/';'/,LIMIT/2000/,NUMP/30/,KSLA/'/'/,IQT/'"'/
	1,MINUS/'-'/,ISTAR/'*'/,ICOMM/','/,ICOL/':'/,ILESS/'<'/
C  IAA=A  IDD=D  IEE=E  IF=F  INN=N  IPP=P  ISS=S  ITT=T
	DATA IBLA/' '/,TYPE/'TYPE'/,TYPD/'TYPD'/,
	1 HELP/'HELP'/,IQUES/'?'/,EDIT/'EDIT'/
	1 ,ISCA/'C','P','D','O','E','F','Z','G','S','A','T','B'/
	1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
	1,IALPH/'H','I','J','K','L','M','N','Q','R','U','V','W','X'
	1,'Y'/


	ITYP=0
	JOUT=JTYPE
C*** ABOVE CAUSE TYPEOUT ON SCREEN (PUT IN PROMPT FOR THIS LATER.)
      LPAR=0
      IPRN=0
      QX=0
      MOT=0
      IRETRO=-1 
      INVRT=-1
      ICON=-1
      LCNT=1
      IPAREN=0
      JZ=1  
      IAMP=0
C  IAMP IS 'BLANK LINE'FLAG ON PP1-3.
      T5=0  
      NINS=0
      K=0
      IDALL=-1
      QTS=-1.
      NWZ=1
      BNW(1)=0
      I=1
      KL=0  
      TP=0  
      RA=0  
      CHN=0 
      DO 127 K=1,77,3
127      LIST(K)=0
C  INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
      NWX=0
      BY=-1
      DO 1128 K=1,KZY     
      INVIS(K)=0
      RINST(K)=0
      NP(K)=0
      IQ(K)=0
      DO 1128 L=1,32    
1128   PCH(K,L)=0 

      ITYP=-1
      JED=-1
2112      WRITE(JTYPE,8002)
	READ(JTYPE,1)JNP
	IF(JNP(1).NE.IBLA)GO TO 4112
	IF(FLNM.EQ.0)GO TO 2112
	RNAM=FLNM
C REMEMBERS LAST FILE NAME GIVEN.
	GO TO 129
4112	CALL PACKER(RNAM,JNP)
C**** ONLY UP TO 4 LETTERS IN FILE NAMES.
999      IF(RNAM.NE.EDIT)GO TO 3112
      JED=0
      GO TO 2112
C  'EDIT' GOES TO EDIT MODE
3112  IF(RNAM.NE.TYPE)GO TO 128
      ITYP=0
	FLNM=TYPD
C***************** OPEN AN OUTPUT FILE *********
	CALL DISKO(ID20,FLNM,0)
C KOUT=DEVICE NUMBER, FLNM=FILE NAME, 0=OUTPUT, (-1=INPUT)
      CALL READIT
C******* IS A5 AVAILABLE?? *************
1   	 FORMAT(80A1)
8002      FORMAT(' TYPE FILE NAME--  '$)
300	FORMAT(I,3F)

128	IF(RNAM.NE.HELP)GO TO 129
C *** NO HELP YET***
129        FLNM=RNAM
C*********** OPEN AN INPUT FILE ******************
	CALL DISKO(ID23,FLNM,-1)

	CALL OUTINF
C OUTINF IS A DUMMY IF USING 2-PART SCORE. WITH 1-PART SCORE IT PROMPTS
C FOR OUTPUT INFO.
	CALL READIT

      END


C11 **** THIS NEXT MUST BE CHANGED TO PACK 4 CHARS. INTO DBL PREC. INT. WD.
	SUBROUTINE PACKER(NAM,INP)
	COMMON /BLA/IBLA,KSLA,ISEMI,MINUS,ISTAR,ICOMM,ICOL,IQUES,ILESS
CQQ	DOUBLE PRECISION NAM
	DIMENSION INP(1),KNM(5)
	DATA KK/128/,LL/"377777777777/,JJ/"2000000000/
	1 , MM/"774000000000/

CC	LEND=0
	NAM=0  
	DO 1 J=1,80
	N=INP(J)
1	IF(N.EQ.IBLA.OR.N.EQ.ISEMI.OR.N.EQ.KSLA)GO TO 2
2	II=J
	J=J-1
	IF(N.EQ.KSLA)II=J
C TO CATCH "TEMPO/11 72 120/" ETC.
	N=J
	IF(J.GT.4)N=4
	DO 3 M=80,1,-1
3	IF(INP(M).NE.IBLA)GO TO 4
C BLANK LINE, GO BACK
	RETURN
4	DO 10 K=1,5
	IF(K.GT.N)GO TO 11
	KNM(K)=INP(K)
	GO TO 10
11	KNM(K)=IBLA
10	CONTINUE
C N=WDCNT OF INST NAME
	DO 12 K=5,1,-1
	NAM=NAM .OR. (KNM(K) .AND. MM)
	IF (K.EQ.1)GO TO 70
17	IF (NAM.GE.0)GO TO 13
	NAM = (( NAM .AND. LL)/KK) .OR. JJ
	GO TO 12
13	NAM = NAM / KK
12	CONTINUE

70	IF(M.LE.J)RETURN
C JUMP IF ONLY A NAME
	DO 7 I=1,M-II
7	INP(I)=INP(I+II)
	DO 8 I=M-J+1,M
8	INP(I)=IBLA
	END